Celem analizy jest znalezienie i powiązania pomiędzy dobrobytem w krajach, a ceną złota, bitcoina, S&P Composite oraz kursami wymiany walut.
Na rok 2018 według Międzynarodowego Funduszu Walutowego największą gospodarką świata są Stany Zjednoczone. Na rozwuj tak dużej gospodraki ma wspływ wiele czynników. Drugą gospodarką są Chiny. W raporcie zostaną przeanalizowane wskaźniki dobrobytu Stanów Zjednoczonych i wpływ Chińskiego Yuan-a.
World_Development_Indicators <- read_excel("Data pack/World_Development_Indicators.xlsx")
SP_Composite <- read.table("Data pack/S&P Composite.csv", sep = ",", header = TRUE)
Gold_prices <- read.csv("Data pack/Gold prices.csv")
Bitcoin_diff <- read.csv("Data pack/Bitcoin/BCHAIN-DIFF.csv") # diff to jest trudność wydobycia
Bitcoin_hrate <- read.csv("Data pack/Bitcoin/BCHAIN-HRATE.csv") # liczba tera hashy wykonanych
Bitcoin_mkpru <- read.csv("Data pack/Bitcoin/BCHAIN-MKPRU.csv") # średnia wartość rynkowa
Bitcoin_trvou <- read.csv("Data pack/Bitcoin/BCHAIN-TRVOU.csv") # całkowita wartość bitcoinów
Currency_Exchange_Rates <- read.csv("Data pack/CurrencyExchangeRates.csv")
Zbiór zawiera dane o kursach walut. Dane pochodzą z lat 1995, 2018, co ogranicza nam pozostałe zbiory do podanego okresu. Brakujące dane zostaną zinterpolowane. Walutą która zostanei poddane analizie będzie Chiński Yuan, jako waluta drugiej gospodarki świata. Waluta ta jest o tyle ciekawe, że jest odgórnie sterowana przez rząd Chińskiej Republiki Ludowej.
Currency_Exchange_Rates_DF <- data.frame(Currency_Exchange_Rates) %>%
select(Date, Chinese.Yuan) %>%
group_by(substr(Date, 0,4)) %>%
summarize( Chinese.Yuan = mean(Chinese.Yuan, na.rm=TRUE))
colnames(Currency_Exchange_Rates_DF) <- c("Year", "Yuan")
Currency_Exchange_Rates_DF$Yuan <- na.approx(Currency_Exchange_Rates_DF$Yuan)
ggplot(Currency_Exchange_Rates_DF, aes(x=Year, y=Yuan, group=1)) +
geom_line(aes(group=1)) +
geom_point() +
labs(x = "Rok", y = "Wartość Yuan do USD") +
scale_x_discrete(breaks=seq(1995, 2020, 5))
Zbiór objemuje 201 krajów i 7 kategorii zamożności, do których klasyfikują się poszczegulne kraje. Zbiór jest opisany w trzech wymiarach: Rok, Kraj, współczynniki dobrobytu.
Zbiór został poddany tranpozycji, oraz sprowadzony do dwóch wymiarów, poprzez wybranie StanóW Zjednoczonych jako interesującego nas kraju.
Kategorie, które są w części puste nie zostaną poddane analizie ze względu na brak danych. Po odfiltrowaniu atrybutów zawierajacych wartości puste otrzymujemy 125 kolumn.
USA_Indicators_DF <- data.frame(World_Development_Indicators) %>%
filter(Country.Name %in% c("United States")) %>%
subset(select = -c(Country.Name, Country.Code, Series.Code))
USA_Indicators_DF[USA_Indicators_DF == ".."] <- NA
USA_Indicators_DF = setNames(data.frame(t(USA_Indicators_DF[,-1])), USA_Indicators_DF[,1])
USA_Indicators_DF <- cbind(rownames(USA_Indicators_DF), USA_Indicators_DF)
rownames(USA_Indicators_DF) <- NULL
colnames(USA_Indicators_DF)[1] <- "Year"
USA_Indicators_DF <- USA_Indicators_DF %>%
mutate(Year = substr(Year, 2, 5)) %>%
filter(Year >= 1995) %>%
filter(Year <= 2018)
USA_Indicators_DF <- data.frame(lapply(USA_Indicators_DF,as.numeric))
na_sum <- data.frame(colSums(is.na(USA_Indicators_DF)))
interesting_USA_Indicators_DF <- USA_Indicators_DF[,na_sum == 0]
amount_chart <- na_sum %>%
mutate(Na.Amount = colSums.is.na.USA_Indicators_DF..) %>%
group_by(Na.Amount) %>%
count(Na.Amount)
ggplot(amount_chart, aes(x=Na.Amount, y=n)) +
geom_bar(stat="identity") +
labs(x="Liczba warości pustych", y="Liczba atrybutów") +
scale_x_continuous(breaks=seq(0, 26, 2)) +
scale_y_continuous(breaks=seq(0, 150, 25))
Z wykresu można zaobserować, że występuje dużo ciemnych, czerwonych i niebieskich plam sygnalizujących dużą korelację. Gdy weźmiemy mniejszą próbkę możemy zaobserwoać, że zbior posiada atrybuty, które sa od siebie w sposób oczywisty zależne, jak przykładowo liczba mieszkańców ogóleni i liczba kobiet/mężczyzn w Stanach Zjednoczonych.
Aby poradzić sobie z problemem z zaleznymi atrybutami wykorzystane zostaną te najbardziej ogólne:
Zbiór opisuje właściwości indeksu S&P Composite. Zbiór został pogrupowany względem roku, a z wartości wyciągnięto średnią. Wartości puste zostały pominięte.
Na wykresie zostały zaprezentowane dostępne atrybuty zbioru. Można na jego podstwie wywnioskować, że S.P.Composite, Ral.Price, Dividend, i Real.Dividend mają podobny kształt. Tak samo Earnings i Real.Earnings.
W dalszej analizie pominiemy atrybuty Real.Price, Dividend, Real.Dividen oraz Real.Earnings.
Intrpretacja wskaźników:
SP_Composite_DF <- data.frame(SP_Composite) %>%
mutate(Year = as.numeric(substr(Year, 0, 4))) %>%
filter(Year >= 1995) %>%
filter(Year <= 2018) %>%
group_by(Year) %>%
summarize(S.P.Composite = mean(S.P.Composite, na.rm=TRUE),
Dividend = mean(Dividend),
Earnings = mean(Earnings, na.rm=TRUE),
CPI = mean(CPI, na.rm=TRUE),
Long.Interest.Rate = mean(Long.Interest.Rate, na.rm=TRUE),
Real.Price = mean(Real.Price),
Real.Dividend = mean(Real.Dividend),
Real.Earnings = mean(Real.Earnings),
Cyclically.Adjusted.PE.Ratio = mean(Cyclically.Adjusted.PE.Ratio, na.rm=TRUE)
)
chart_SP_Composite <- SP_Composite_DF %>% pivot_longer(2:10) %>% filter(!is.na(value))
ggplot( chart_SP_Composite , aes(x=Year, y=value)) +
geom_line(aes(group=1)) +
geom_point() +
facet_wrap(name ~ ., scales="free", ncol = 3) +
scale_x_discrete(breaks=seq(1995, 2020, 5))
SP_Composite_DF <- SP_Composite_DF %>%
select(Year,
SP.Composite.CPI = CPI,
SP.Composite.Cyclically.Adjusted.PE.Ratio = Cyclically.Adjusted.PE.Ratio,
SP.Composite.Earnings = Earnings,
SP.Composite.Long.Interest.Rate = Long.Interest.Rate,
S.P.Composite = S.P.Composite
)
Ponieważ cena złota jest ma tą samą wartość, wyrazoną w różncyh walutach, to na potrzeby analizy przyjęta zosatnie cena złota wyrażana w dolarach. Dodatkowo przyjemiemy średnią z notowania porannego i wieczornego.
Gold_prices_DF <- data.frame(Gold_prices) %>%
mutate(Year = substr(Date, 0, 4)) %>%
filter(Year >= 1995) %>%
filter(Year <= 2018) %>%
group_by(Year) %>%
summarize( USD = (mean(USD..AM., na.rm=TRUE) + mean(USD..PM., na.rm=TRUE))/2)
colnames(Gold_prices_DF) <- c("Year", "Gold_Price_USD")
ggplot(Gold_prices_DF, aes(x=Year, y=Gold_Price_USD, group=1)) +
geom_line(aes(group=1)) +
geom_point() +
labs(x = "Rok", y = "Cena złota [USD]") +
scale_x_discrete(breaks=seq(1995, 2020, 5))
Do analizy wykorzystamy średnią cenę bitcoina w ciagu roku. Lata przed 2009 otrzymają wartość 0.
mock_Bitcoin_mkpru_DF <- data.frame(c(1995:2009), 0)
clean_bitcoin <- function(data, name) {
clean <- data.frame(data) %>%
mutate(Year = substr(Date, 0, 4)) %>%
filter(Year >= 1995) %>%
filter(Year <= 2018) %>%
group_by(Year) %>%
summarize(Value = (mean(Value)))
colnames(clean) <- c("Year", name)
names(mock_Bitcoin_mkpru_DF) <- names(clean)
clean <- rbind(clean, mock_Bitcoin_mkpru_DF)
}
# zbiorcze
Bitcoin_mkpru_DF <- clean_bitcoin(Bitcoin_mkpru, "Bitcoin_Price")
Bitcoin_diff_DF <- clean_bitcoin(Bitcoin_diff, "Bitcoin_Difficult")
Bitcoin_hrate_DF <- clean_bitcoin(Bitcoin_hrate, "Bitcoin_Hash")
Bitcoin_trvou_DF <- clean_bitcoin(Bitcoin_trvou, "Bitcoin_Total_Value")
bitcoin1 <- merge(Bitcoin_mkpru_DF, Bitcoin_diff_DF)
bitcoin2 <- merge(Bitcoin_hrate_DF, Bitcoin_trvou_DF)
bitcoin <- merge(bitcoin1, bitcoin2)
chart_bitcoin <- bitcoin %>% pivot_longer(2:5) %>% filter(!is.na(value))
ggplot( chart_bitcoin , aes(x=Year, y=value)) +
geom_line(aes(group=1)) +
geom_point() +
facet_wrap(name ~ ., scales="free", ncol = 2) +
scale_x_discrete(breaks=seq(1995, 2020, 5))
Z zaprezentowanych powyżej wykresów można zaobserwować, że wszytskie 4 wartości są od siebie zależne. Na potrzeby dalszych analiz skorzystamy z atrybutu ceny bitcoina.
df1 <- merge(Currency_Exchange_Rates_DF, general_USA_Indicators_DF)
df2 <- merge(Gold_prices_DF, Bitcoin_mkpru_DF)
df3 <- merge(df2, SP_Composite_DF)
df <- merge(df1, df3)
Poniższy wykres przedstawia wartość współczynnika korelacji Pearsona między parametrami atrybutów w zbiorze.
Poniższa tabela prezentuje 20 par atrybutów z największym współczynnikiem korelacji Pearsona.
| rowname | colname | value |
|---|---|---|
| Population..total | Urban.population | 0.9998361 |
| Population..total | SP.Composite.CPI | 0.9967195 |
| SP.Composite.CPI | Urban.population | 0.9957596 |
| GDP.per.capita..current.US.. | Urban.population | 0.9918233 |
| GDP.per.capita..current.US.. | Population..total | 0.9909770 |
| GDP.per.capita..current.US.. | SP.Composite.CPI | 0.9907750 |
| Gold_Price_USD | Yuan | -0.9611509 |
| Population..total | SP.Composite.Long.Interest.Rate | -0.9490566 |
| SP.Composite.Long.Interest.Rate | Urban.population | -0.9472895 |
| SP.Composite.CPI | SP.Composite.Long.Interest.Rate | -0.9409388 |
| CO2.emissions..metric.tons.per.capita. | Yuan | 0.9370947 |
| CO2.emissions..metric.tons.per.capita. | SP.Composite.CPI | -0.9276107 |
| CO2.emissions..metric.tons.per.capita. | Gold_Price_USD | -0.9267564 |
| SP.Composite.CPI | Yuan | -0.9241426 |
| CO2.emissions..metric.tons.per.capita. | Population..total | -0.9158413 |
| CO2.emissions..metric.tons.per.capita. | Urban.population | -0.9129727 |
| GDP.per.capita..current.US.. | SP.Composite.Long.Interest.Rate | -0.9111305 |
| Population..total | Yuan | -0.9050637 |
| CO2.emissions..metric.tons.per.capita. | GDP.per.capita..current.US.. | -0.9018189 |
| CO2.emissions..metric.tons.per.capita. | SP.Composite.Long.Interest.Rate | 0.9008162 |
Najbardziej wyróżniającym korelacjami są:
Ostateczny zbiór poddany analizie zawiera 15 atrybutów i 24 obserwacje.
options(knitr.kable.NA = '')
knitr::kable(summary(df[1:6]))
| Year | Yuan | Urban.population | Population..total | Inflation..consumer.prices..annual… | GDP.per.capita..current.US.. | |
|---|---|---|---|---|---|---|
| Length:25 | Min. :6.143 | Min. :205718394 | Min. :266278000 | Min. :-0.3555 | Min. :28691 | |
| Class :character | 1st Qu.:6.644 | 1st Qu.:225792302 | 1st Qu.:284968955 | 1st Qu.: 1.5860 | 1st Qu.:37133 | |
| Mode :character | Median :7.606 | Median :241795278 | Median :301231207 | Median : 2.2701 | Median :47100 | |
| Mean :7.406 | Mean :239857040 | Mean :299146527 | Mean : 2.1223 | Mean :45093 | ||
| 3rd Qu.:8.277 | 3rd Qu.:254614421 | 3rd Qu.:313877662 | 3rd Qu.: 2.8527 | 3rd Qu.:51603 | ||
| Max. :8.374 | Max. :268844029 | Max. :326838199 | Max. : 3.8391 | Max. :63064 |
knitr::kable(summary(df[7:12]))
| CO2.emissions..metric.tons.per.capita. | Gold_Price_USD | Bitcoin_Price | SP.Composite.CPI | SP.Composite.Cyclically.Adjusted.PE.Ratio | SP.Composite.Earnings | |
|---|---|---|---|---|---|---|
| Min. :14.81 | Min. : 271.1 | Min. : 0.000 | Min. :152.4 | Min. :16.92 | Min. : 16.46 | |
| 1st Qu.:16.10 | 1st Qu.: 363.6 | 1st Qu.: 0.000 | 1st Qu.:177.1 | 1st Qu.:22.72 | 1st Qu.: 36.28 | |
| Median :18.96 | Median : 695.9 | Median : 0.000 | Median :207.3 | Median :25.98 | Median : 55.30 | |
| Mean :18.03 | Mean : 798.1 | Mean : 524.623 | Mean :202.6 | Mean :26.70 | Mean : 61.58 | |
| 3rd Qu.:19.60 | 3rd Qu.:1250.3 | 3rd Qu.: 8.474 | 3rd Qu.:229.6 | 3rd Qu.:29.85 | 3rd Qu.: 87.40 | |
| Max. :20.47 | Max. :1668.9 | Max. :7571.679 | Max. :251.1 | Max. :42.07 | Max. :123.30 |
Niniejsza sekcja opisuje proces tworzenia regresora, którego zadaniem jest przewidywanie ceny złota. Ze zbioru zostanie usunięty rok ze względu na XYZ.
idx <- createDataPartition(df$Gold_Price_USD, p=0.7, list=F)
d1 <- data.frame(price=df[idx,]$Gold_Price_USD)
d2 <- data.frame(price=df[-idx,]$Gold_Price_USD)
ggplot(mapping=aes(alpha=0.4)) +
geom_density(aes(price, fill="red"), d1) +
geom_density(aes(price, fill="blue"), d2) +
theme_minimal()